home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Src / symboot.c < prev    next >
C/C++ Source or Header  |  1993-06-15  |  10KB  |  379 lines
  1. /* ******************************************************************** */
  2. /*  symbols.c        Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /*  General symbol hacking and global oblist                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, March 1990 (During compiler rationalisation)
  10.  */
  11.  
  12. #include <stdio.h>
  13. #include "funcalls.h"
  14. #include "defs.h"
  15. #include "structs.h"
  16. #include "global.h"
  17. #include "error.h"
  18. #include <string.h>
  19. #include "table.h"
  20. #include "symboot.h"
  21. #include "allocate.h"
  22. #include "copy.h"
  23.  
  24. /* Changed 'cos of a KSR-compiler bug! */
  25. #define strings_equal_p(a,b) ((a)[0] == (b)[0] && (strcmp(a,b)==0))
  26.  
  27. LispObject ObList;
  28.  
  29.  
  30. typedef enum { LHere, LLeft, LRight, LFirst } LookupDirection;
  31. static LispObject find_name_in_oblist(LispObject ,char *,LookupDirection *);
  32. static void add_sym_to_oblist(LispObject where,LispObject sym, LookupDirection dir);
  33.   
  34. LispObject get_symbol(LispObject* stackbase, char *name)
  35. {
  36.   LookupDirection dir;
  37.   LispObject newloc,sym;
  38.   LispObject *stacktop=stackbase;
  39.  
  40.   ATOMIC(stackbase,
  41.     newloc=find_name_in_oblist(ObList,name,&dir);
  42.     if (dir==LHere)
  43.      sym=newloc;
  44.     else
  45.       { /* NOT GC SAFE */
  46.     STACK_TMP(newloc);
  47.         sym=allocate_symbol(stacktop,name);
  48.     UNSTACK_TMP(newloc);
  49.         add_sym_to_oblist(newloc,sym,dir);
  50.       }
  51.      );
  52.   return sym;
  53. }
  54.  
  55. /* Provided for compatibility */
  56.  
  57. LispObject get_symbol_by_copying(LispObject *stackbase,char *name)
  58. {
  59.   return(get_symbol(stackbase,name));
  60. }
  61.  
  62. static void add_sym_to_oblist(LispObject where,LispObject sym, LookupDirection dir)
  63. {
  64.   switch(dir)
  65.     {
  66.     case LLeft:
  67.       where->SYMBOL.left=sym;
  68.       break;
  69.  
  70.     case LRight:
  71.       where->SYMBOL.right=sym;
  72.       break;
  73.       
  74.     case LFirst:
  75.       ObList=sym;
  76.     }
  77. }
  78.  
  79.  
  80. static LispObject find_name_in_oblist(LispObject tree,char *str,LookupDirection *dir)
  81. {
  82.   LookupDirection mydir=LFirst;
  83.   LispObject prev=NULL;
  84.   int newhash=hash(str);
  85.   
  86.   while(TRUE)
  87.     {
  88.       if (tree==NULL)
  89.     {
  90.       *dir=mydir;
  91.       return prev;
  92.     }
  93.  
  94.       if (newhash==tree->SYMBOL.hash)
  95.     {
  96.       if (strings_equal_p(stringof(tree->SYMBOL.pname),str))
  97.         {    
  98.           *dir=LHere;
  99.           return tree;
  100.         }
  101.       else
  102.         {
  103.           prev=tree; mydir=LLeft;
  104.           tree=tree->SYMBOL.left;
  105.         }
  106.     }
  107.       else 
  108.     {
  109.       if (tree->SYMBOL.hash<newhash)
  110.         {
  111.           prev=tree; mydir=LLeft;
  112.           tree=tree->SYMBOL.left;
  113.         }
  114.       else
  115.         {
  116.           prev=tree; mydir=LRight;
  117.           tree=tree->SYMBOL.right;
  118.         }
  119.     }
  120.     }
  121. }    
  122.  
  123. int reserved_symbol_p(LispObject sym)
  124. {
  125.   return((sym == sym_dynamic ||
  126.       sym == sym_dynamic_let ||
  127.       sym == sym_dynamic_setq ||
  128.       sym == sym_dynamic_set ||
  129. /*
  130.       sym == sym_defclass ||
  131.       sym == sym_defcondition ||
  132. */
  133.       sym == sym_defconstant ||
  134. /*
  135.       sym == sym_defgeneric ||
  136. */
  137.       sym == sym_deflocal ||
  138.       sym == sym_defmacro ||
  139. /*
  140.       sym == sym_defmethod ||
  141.       sym == sym_defstruct ||
  142. */
  143.       sym == sym_defun || 
  144.       sym == sym_defvar ||
  145.       sym == sym_if ||
  146.       sym == sym_lambda ||
  147. /*
  148.       sym == sym_letcc ||
  149.           sym == sym_with_handler ||
  150. */
  151.       sym == sym_nil || 
  152.       sym == sym_quote ||
  153.       sym == lisptrue ||
  154.       sym == sym_setq));
  155. }
  156.  
  157. /* Useful symbols to have... */
  158.  
  159. LispObject sym_nil;
  160.  
  161. LispObject sym_define;
  162. LispObject sym_function,sym_macro,sym_constant;
  163.  
  164. LispObject sym_defclass,sym_defcondition,sym_defconstant,sym_defgeneric,
  165.            sym_deflocal,sym_defmacro,sym_defmethod,sym_defstruct,sym_defun;
  166.  
  167. LispObject sym_defmodule,sym_load_module,sym_start_module,sym_enter_module;
  168.  
  169. LispObject sym_root;
  170.  
  171. LispObject sym_loaded_modules;
  172.  
  173. LispObject sym_lambda,sym_macro_lambda,sym_setq,sym_if,sym_progn;
  174. LispObject sym_import,sym_expose,sym_expose_except,sym_rename,sym_export;
  175. LispObject sym_root;
  176. LispObject sym_letcc,sym_unwind_protect;
  177.  
  178. LispObject sym_methods;
  179.  
  180. LispObject sym_defvar,sym_dynamic_setq,
  181.            sym_dynamic_set,sym_dynamic,sym_dynamic_let;
  182.  
  183. LispObject sym_with_handler;
  184.  
  185. LispObject sym_rest;
  186.  
  187. LispObject sym_cons;
  188.  
  189. /* defstruct symbols... */
  190.  
  191. LispObject sym_initarg,sym_initargs,sym_initform,sym_reader,sym_writer,
  192.            sym_accessor,sym_class,sym_mutable;
  193.  
  194. LispObject sym_constructor,sym_metaclass,sym_metaclass_initargs;
  195.  
  196. LispObject sym_position;
  197.  
  198. LispObject sym_message,sym_error_value;
  199.  
  200. LispObject sym_anonymous_class;
  201.  
  202. LispObject sym_name,sym_superclass,sym_slot_descriptions;
  203.  
  204. LispObject sym_exit;
  205.  
  206. LispObject sym_evalcm;
  207.  
  208. LispObject sym_tagbody;
  209.  
  210. LispObject sym_quote, sym_unquote, sym_unquote_splicing;
  211.  
  212. void initialise_symbols(LispObject *stacktop)
  213. {
  214.   /* Garbage proofed by virtue of being on the object list */
  215.   /* Better do gensyms differently... */
  216.   add_root(&ObList);
  217.   
  218.  
  219.   sym_nil = get_symbol(stacktop,"nil");
  220.   add_root(&sym_nil);
  221.   sym_define   = get_symbol(stacktop,"define");
  222.   add_root(&sym_define);
  223.   sym_function = get_symbol(stacktop,"function");
  224.   add_root(&sym_function);
  225.   sym_macro    = get_symbol(stacktop,"macro");
  226.   add_root(&sym_macro);
  227.   sym_constant = get_symbol(stacktop,"constant");
  228.   add_root(&sym_constant);
  229.   
  230.   sym_defclass     = get_symbol(stacktop,"defclass");
  231.   add_root(&sym_defclass);
  232.   sym_defcondition = get_symbol(stacktop,"defcondition");
  233.   add_root(&sym_defcondition);
  234.   sym_defconstant  = get_symbol(stacktop,"defconstant");
  235.   add_root(&sym_defconstant);
  236.   sym_defgeneric   = get_symbol(stacktop,"defgeneric");
  237.   add_root(&sym_defgeneric);
  238.   sym_deflocal     = get_symbol(stacktop,"deflocal");
  239.   add_root(&sym_deflocal);
  240.   sym_defmacro     = get_symbol(stacktop,"defmacro");
  241.   add_root(&sym_defmacro);
  242.   sym_defmethod    = get_symbol(stacktop,"defmethod");
  243.   add_root(&sym_defmethod);
  244.   sym_defstruct    = get_symbol(stacktop,"defstruct");
  245.   add_root(&sym_defstruct);
  246.   sym_defun        = get_symbol(stacktop,"defun");
  247.   add_root(&sym_defun);
  248.   
  249.   sym_defmodule  = get_symbol(stacktop,"defmodule");
  250.   add_root(&sym_defmodule);
  251.   sym_load_module = get_symbol(stacktop,"load-module");
  252.   add_root(&sym_load_module);
  253.   sym_start_module = get_symbol(stacktop,"start-module");
  254.   add_root(&sym_start_module);
  255.   sym_enter_module = get_symbol(stacktop,"enter-module");
  256.   add_root(&sym_enter_module);
  257.   sym_loaded_modules = get_symbol(stacktop,"loaded-modules");
  258.   add_root(&sym_loaded_modules);
  259.   
  260.   sym_root = get_symbol(stacktop,"root");
  261.   add_root(&sym_root);
  262.   
  263.   sym_lambda  = get_symbol(stacktop,"lambda");
  264.   add_root(&sym_lambda);
  265.   sym_macro_lambda = get_symbol(stacktop,"macro-lambda");
  266.   add_root(&sym_macro);
  267.   sym_setq    = get_symbol(stacktop,"setq");
  268.   add_root(&sym_setq);
  269.   sym_if      = get_symbol(stacktop,"if");
  270.   add_root(&sym_if);
  271.   sym_progn   = get_symbol(stacktop,"progn");
  272.   add_root(&sym_progn);
  273.   sym_quote   = get_symbol(stacktop,"quote");
  274.   add_root(&sym_quote);
  275.   
  276.   sym_import = get_symbol(stacktop,"import");
  277.   add_root(&sym_import);
  278.   sym_expose = get_symbol(stacktop,"expose");
  279.   add_root(&sym_expose);
  280.   sym_expose_except = get_symbol(stacktop,"expose-except");
  281.   add_root(&sym_expose_except);
  282.   sym_rename = get_symbol(stacktop,"rename");
  283.   add_root(&sym_rename);
  284.   
  285.   sym_export = get_symbol(stacktop,"export");
  286.   add_root(&sym_export);
  287.   
  288.   sym_root = get_symbol(stacktop,"root");
  289.   add_root(&sym_root);
  290.   
  291.   sym_letcc          = get_symbol(stacktop,"let/cc");
  292.   add_root(&sym_letcc);
  293.   sym_unwind_protect = get_symbol(stacktop,"unwind-protect");
  294.   add_root(&sym_unwind_protect);
  295.   
  296.   sym_with_handler   = get_symbol(stacktop,"with-handler");
  297.   add_root(&sym_with_handler);
  298.   
  299.   sym_methods = get_symbol(stacktop,"methods");
  300.   add_root(&sym_methods);
  301.   
  302.   sym_defvar       = get_symbol(stacktop,"defvar");
  303.   add_root(&sym_defvar);
  304.   sym_dynamic_setq = get_symbol(stacktop,"dynamic-setq");
  305.   add_root(&sym_dynamic_setq);
  306.   sym_dynamic_set  = get_symbol(stacktop,"dynamic-set");
  307.   add_root(&sym_dynamic_set);
  308.   sym_dynamic_let  = get_symbol(stacktop,"dynamic-let");
  309.   add_root(&sym_dynamic_let);
  310.   sym_dynamic      = get_symbol(stacktop,"dynamic");
  311.   add_root(&sym_dynamic);
  312.   
  313.   sym_rest = get_symbol(stacktop,"rest");
  314.   add_root(&sym_rest);
  315.   
  316.   sym_cons = get_symbol(stacktop,"cons");
  317.   add_root(&sym_cons);
  318.   
  319.   sym_initarg  = get_symbol(stacktop,"initarg");
  320.   add_root(&sym_initarg);
  321.   sym_initargs = get_symbol(stacktop,"initargs");
  322.   add_root(&sym_initargs);
  323.   sym_initform = get_symbol(stacktop,"initform");
  324.   add_root(&sym_initform);
  325.   sym_reader   = get_symbol(stacktop,"reader");
  326.   add_root(&sym_reader);
  327.   sym_writer   = get_symbol(stacktop,"writer");
  328.   add_root(&sym_writer);
  329.   sym_accessor = get_symbol(stacktop,"accessor");
  330.   add_root(&sym_accessor);
  331.   sym_class    = get_symbol(stacktop,"class");
  332.   add_root(&sym_class);
  333.   sym_mutable  = get_symbol(stacktop,"mutable");
  334.   add_root(&sym_mutable);
  335.   
  336.   sym_constructor = get_symbol(stacktop,"constructor");
  337.   add_root(&sym_constructor);
  338.   sym_metaclass   = get_symbol(stacktop,"metaclass");
  339.   add_root(&sym_metaclass);
  340.   sym_metaclass_initargs = get_symbol(stacktop,"metaclass-initargs");
  341.   add_root(&sym_metaclass_initargs);
  342.   
  343.   sym_position = get_symbol(stacktop,"position");
  344.   add_root(&sym_position);
  345.   sym_message = get_symbol(stacktop,"message");
  346.   add_root(&sym_message);
  347.   sym_error_value = get_symbol(stacktop,"error-value");
  348.   add_root(&sym_error_value);
  349.   
  350.   sym_anonymous_class = get_symbol(stacktop,"anonymous-class");
  351.   add_root(&sym_anonymous_class);
  352.   
  353.   sym_name = get_symbol(stacktop,"name");
  354.   add_root(&sym_name);
  355.   sym_superclass = get_symbol(stacktop,"superclass");
  356.   add_root(&sym_superclass);
  357.   sym_slot_descriptions = get_symbol(stacktop,"slot-descriptions");
  358.   add_root(&sym_slot_descriptions);
  359.   
  360.   sym_exit = get_symbol(stacktop,"exit");
  361.   add_root(&sym_exit);
  362.   
  363.   sym_evalcm = get_symbol(stacktop,"eval/cm");
  364.   add_root(&sym_evalcm);
  365.   
  366.   sym_tagbody = get_symbol(stacktop,"tagbody");
  367.   add_root(&sym_tagbody);
  368.  
  369.   sym_quote = get_symbol(stacktop,"quote");
  370.   add_root(&sym_quote);
  371.  
  372.   sym_unquote = get_symbol(stacktop,"unquote");
  373.   add_root(&sym_unquote);
  374.  
  375.   sym_unquote_splicing = get_symbol(stacktop,"unquote-splicing");
  376.   add_root(&sym_unquote_splicing);
  377.  
  378. }
  379.